package JasPerl::EL::Expression;

use strict;
use warnings;

use Carp qw{ confess croak };
use Data::Dumper;

use JasPerl::EL::Util qw{ coerce_boolean coerce_number coerce_string compare };
use JasPerl::Util::Boolean qw(TRUE FALSE);
use JasPerl::Util::Number;

my %TYPES = (
    'bool' => sub {
        return JasPerl::Util::Boolean->from($_[0]);
    },

    'int' => sub {
        return JasPerl::Util::Number->from($_[0]);
    },

    'float' => sub {
        return JasPerl::Util::Number->from($_[0]);
    },

    'string' => sub {
        return $_[0];
    },

    'null' => sub {
    }
);

my %OP = (
    'cond' => sub {
        my ($self, $resolver, $cond, @branches) = @_;
        if (coerce_boolean($cond)) {
            return $self->_eval($resolver, $branches[0]);
        } else {
            return $self->_eval($resolver, $branches[1]);
        }
    },

    'add' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        my $lhs = coerce_number($val);
        my $rhs = coerce_number($self->_eval($resolver, $expr));
        return JasPerl::Util::Number->new($lhs->value + $rhs->value);
    },

    'sub' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        my $lhs = coerce_number($val);
        my $rhs = coerce_number($self->_eval($resolver, $expr));
        return JasPerl::Util::Number->new($lhs->value - $rhs->value);
    },

    'mul' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        my $lhs = coerce_number($val);
        my $rhs = coerce_number($self->_eval($resolver, $expr));
        return JasPerl::Util::Number->new($lhs->value * $rhs->value);
    },

    'div' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        my $lhs = coerce_number($val);
        my $rhs = coerce_number($self->_eval($resolver, $expr));
        return JasPerl::Util::Number->new($lhs->value / $rhs->value);
    },

    'mod' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        my $lhs = coerce_number($val);
        my $rhs = coerce_number($self->_eval($resolver, $expr));
        return JasPerl::Util::Number->new($lhs->value % $rhs->value);
    },

    'or' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        return TRUE if coerce_boolean($val)->value;
        return coerce_boolean($self->_eval($resolver, $expr));
    },

    'and' => sub {
        my ($self, $resolver, $val, $expr) = @_;
        return FALSE unless coerce_boolean($val)->value;
        return coerce_boolean($self->_eval($resolver, $expr));
    },

    'eq' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return TRUE unless defined $lhs or defined $rhs;
        return FALSE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) == 0 ? TRUE : FALSE;
    },

    'ne' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return FALSE unless defined $lhs or defined $rhs;
        return TRUE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) != 0 ? TRUE : FALSE;
    },

    'lt' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return FALSE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) < 0 ? TRUE : FALSE;
    },

    'le' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return TRUE unless defined $lhs or defined $rhs;
        return FALSE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) <= 0 ? TRUE : FALSE;
    },

    'gt' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return FALSE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) > 0 ? TRUE : FALSE;
    },

    'ge' => sub {
        my ($self, $resolver, $lhs, $expr) = @_;
        my $rhs = $self->_eval($resolver, $expr);
        return TRUE unless defined $lhs or defined $rhs;
        return FALSE unless defined $lhs and defined $rhs;
        return compare($lhs, $rhs) >= 0 ? TRUE : FALSE;
    },

    'not' => sub {
        # warn "-- not $_[2]\n";
        return coerce_boolean($_[2]) ? FALSE : TRUE;
    },

    'neg' => sub {
        return JasPerl::Util::Number->new(-coerce_number($_[2])->value);
    },

    'empty' => sub {
        my ($self, $resolver, $obj) = @_;
        # warn "-- empty $obj ", $self->{src}, "\n";
        if (my $type = ref $obj) {
            return @{$obj} ? FALSE : TRUE if $type eq 'ARRAY';
            return %{$obj} ? FALSE : TRUE if $type eq 'HASH';
            return FALSE;
        } else {
            return TRUE unless defined $obj;
            return length($obj) ? FALSE : TRUE;
        }
    },

    'dot' => sub {
        use Scalar::Util qw{ blessed };
        # TODO: BeanUtil

        my ($self, $resolver, $obj, $expr) = @_;
        return undef unless defined $obj;

        # warn "dot operator: $obj ", Dumper($expr);
        my $prop = $self->_eval($resolver, $expr);
        # warn "dot operator done : $obj $prop\n";
        return undef unless defined $prop;

        if (my $class = blessed $obj) {
            my $name = coerce_string($prop);
            # convert camel case to lower case w/underscores
            $name =~ s/([[:lower:]])([[:upper:]]+)/$1_\L$2\E/g;
            if (my $method = $obj->can("get_$name")) {
                return scalar $obj->$method;
            }
            if (my $method = $obj->can("is_$name")) {
                return $obj->$method ? TRUE : FALSE;
            }
            confess "Property '$prop' not found on type $class";
        } elsif (my $reftype = ref $obj) {
            return $obj->[coerce_number($prop)->value]
                if $reftype eq 'ARRAY';
            return $obj->{coerce_string($prop)}
                if $reftype eq 'HASH';
            confess "Property '$prop' not found on type $reftype";
        } else {
            confess "Property '$prop' not found on scalar '$obj'";
        }
    }
);

my %MATCH = (
    'op' => sub {
        my ($self, $resolver, $expr) = @_;
        my @expr = @{$expr->{expr}};
        my $val = $self->_eval($resolver, shift @expr);

        if (my $op = $OP{$expr->{op}}) {
            return $op->($self, $resolver, $val, @expr);
        } else {
            confess "Error evaluating expression '$self->{src}'";
        }
    },

    'ops' => sub {
        my ($self, $resolver, $expr) = @_;
        my @expr = @{$expr->{expr}};
        my $val = $self->_eval($resolver, shift @expr);

        foreach my $op (map { $OP{$_} } @{$expr->{ops}}) {
            confess "Error evaluating expression '$self->{src}'"
                unless defined $op;
            $val = $op->($self, $resolver, $val, shift @expr);
        }
        return $val;
    },

    'val' => sub {
        my ($self, $resolver, $expr) = @_;
        my $val = $self->_eval($resolver, $expr->{val});

        foreach my $prop (@{$expr->{prop}}) {
            $val = $OP{'dot'}->($self, $resolver, $val, $prop);
        }
        return $val;
    },

    'var' => sub {
        my ($self, $resolver, $expr) = @_;
        return $resolver->($expr->{var});
    },

    'lit' => sub {
        my ($self, $resolver, $expr) = @_;
        if (my $type = $TYPES{$expr->{type}}) {
            return $type->($expr->{value});
        } else {
            confess "Error evaluating expression '$self->{src}'";
        }
    },

    'sub' => sub {
        my ($self, $resolver, $expr) = @_;
        my $glob = $expr->{sub};
        my @args = map { $self->_eval($resolver, $_) } @{$expr->{args}};
        # return &{$expr->{sub}}(@args);
        return *{$glob}{PACKAGE}->$glob(@args);
    },

    'bool' => sub {
        return JasPerl::Util::Boolean->from($_[2]->{bool});
    },

    'int' => sub {
        return JasPerl::Util::Number->from($_[2]->{int});
    },

    'num' => sub {
        return JasPerl::Util::Number->from($_[2]->{num});
    },

    'str' => sub {
        return $_[2]->{str};
    },

    'null' => sub {
        return undef;
    }
);

sub new {
    my ($class, $src, $expr) = @_;
    bless { src => $src, expr => $expr }, $class;
}

sub eval {
    my ($self, $resolver) = @_;
    croak "No VariableResolver provided" unless $resolver;
    return $self->_eval($resolver, $self->{expr});
}

sub dump {
    my ($self, $name) = @_;
    my $dumper = Data::Dumper->new([ $self ], [ $name ]);
    $dumper->Terse(1) unless $name;
    $dumper->Indent(1);
    return $dumper->Dump;
}

sub _eval {
    my ($self, $resolver, $expr) = @_;
    #print STDERR "-- _eval: ", Dumper($expr);
    my @match = map { $MATCH{$_} || ( ) } keys %{$expr};
    confess "Error evaluating expression '$self->{src}'" if @match != 1;
    return $match[0]->($self, $resolver, $expr);
}

1;
